home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / amiga / gcc233.lha / geninline / conv.p next >
Text File  |  1992-12-29  |  13KB  |  413 lines
  1. #!/c/perl
  2. # convert pair of clib/proto header and fd file into an inline header
  3. #
  4. # (C) 1992 by Markus Wild
  5. # <wild@nessie.cs.id.ethz.ch> or <wild@amiga.physik.unizh.ch>
  6. #
  7. # this tool requires PERL.
  8. #
  9. # 1.1   92-jun-04    now handles double arguments
  10. # 1.2   92-jul-02    generates stdarg and alias macros. 
  11. # 1.3   92-jul-08    makes use of 2.2.2's new "memory" clobbering, and no longer
  12. #            emits those *(char*)a0=*(char*)a0 hacks.
  13. #
  14. # TODO: handle full ANSI declarations, 
  15. #       eg. void qsort (void *, size_t, size_t, int (*)(const void *, const void *));
  16. #       Currently omit the declaration of the arguments of the function pointers,
  17. #       ie. in this example, use
  18. #       void qsort (void *, size_t, size_t, int (*)());
  19. #
  20. #       perform register allocation in those cases where a4 or a5 is used
  21. #       automatically.
  22. #
  23.  
  24. $#ARGV == 1 || die "Usage: $0 proto-file fd-file\n";
  25.  
  26. open(PROTO_F, $ARGV[0]) || die "Can't open $ARGV[0], $!";
  27. open(FD_F, $ARGV[1]) || die "Can't open $ARGV[1], $!";
  28.  
  29. # set the input record separator to ; to be able to parse multiline 
  30. # declarations. This could get us into troubles with comments.. we will see
  31. $/=";";
  32.  
  33. p_line: while (<PROTO_F>) {
  34. #print "0: ",$_,"\n";
  35.  
  36.   # skip proprocessor statements and comments
  37.   s/\n+/\n/g;
  38. #print "01: ", $_, "\n";
  39.   s/(#.*\n)+//g;
  40. #print "02: ", $_, "\n";
  41.   s/\/\*([^\*]*\*+)*\///g;
  42. #print "03: ", $_, "\n";
  43.   s/^([^\n\(]+\n)+//g;
  44.   
  45.   next if $_ eq "";
  46.   next unless /\(/;
  47.   
  48.   # suppose this is a function declaration
  49.   # this `little' pattern filters out the return type and the argument
  50.   # line. The return type is quite tricky, since it can be a multi word
  51.   # type (like struct foo *), and we shouldn't overwrite the function
  52.   # name by matching against the return type... this seems to work, although
  53.   # I'm not completly sure it does in all cases.
  54.  
  55. #print "1: ",$_;
  56.   s/\(\s*\*/\(\*/g;
  57. #print "2: ",$_;
  58.   s/\s+(\([^\*])/\(\1/g;
  59. #print "3: ",$_;
  60.   /((\w+\s)*\w+\W+)(\w+)\((([^,\(\)]+|\([^\)]*\)|,|\s)*)\)([^;]*);/;
  61.  
  62.   # %result_tab contains the type part written before the function name
  63.   $result_tab{$3} = $1;
  64.   # %result_tab_end contains the type part written after the closing parenthesis
  65.   chop $6;
  66.   $result_tab_end{$3} = $6;
  67.   # %arg_type_tab contains (later only) the type information for the arguments
  68.   $arg_type_tab{$3} = $4;
  69.   
  70.   # compress the types, throw out not needed whitespace as much as we can
  71.   $result_tab{$3} =~ s/\s+/ /g;
  72.   $result_tab_end{$3} =~ s/\s+/ /g;
  73.   $result_tab_end{$3} =~ s/(\s+$)|(^\s+)//g;
  74.   $arg_type_tab{$3} =~ s/\s+/ /g;
  75.   $arg_type_tab{$3} =~ s/\s*,\s*/,/g;
  76.   $arg_type_tab{$3} =~ s/(\s+$)|(^\s+)//g;
  77. }
  78.  
  79. # now parse the given fd file
  80.  
  81. # reset input record separator to newline for fd file
  82. $/="\n";
  83. $bias = 0;
  84. $private = 0;
  85. ($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($lib_base_name = "${2}Base");
  86. $lib_base_name[0] =~ tr/[a-z]/[A-Z]/;
  87.  
  88. f_line: while (<FD_F>) {
  89.   # strip terminating new line
  90.   chop;
  91.  
  92.   # get rid of comments
  93.   /^\*/ && next f_line;
  94.  
  95.   # parse commands
  96.   /^##base _(\w+)/    && ($lib_base_name = $1) && next f_line;
  97.   /^##bias (\d+)/    && ($bias = $1)         && next f_line;
  98.   /^##public/        && (($private = 0), 1)     && next f_line;
  99.   /^##private/        && ($private = 1)     && next f_line;
  100.   last if /^##end/;
  101.  
  102.   # parse function
  103.   /^(\w+)\(([^\)]*)\)\s*\(([^\)]*)\)/;
  104.   
  105.   $reg_tab{$1} = $3;
  106.   $arg_name_tab{$1} = $2;
  107.   $bias_tab{$1} = $bias;
  108.  
  109.   $bias += 6;
  110. }
  111.  
  112. %base_types = (
  113.   'SysBase',        'struct ExecBase *',
  114.   'ConsoleDevice',    'struct Device *',
  115.   'TimerBase',        'struct Device *',
  116.   'DiskfontBase',    'struct Library *',
  117.   'DOSBase',        'struct DosLibrary *',
  118.   'IconBase',        'struct Library *',
  119.   'PotgoBase',        'struct Library *',
  120.   'TranslatorBase',    'struct Library *',
  121.   'XpkBase',        'struct Library *',
  122.   'XpkSubBase',        'struct Library *',
  123.   'SocketBase',        'struct Library *',
  124. );
  125.  
  126. ($lib_base_type = $base_types{$lib_base_name}) || 
  127.   ($lib_base_type = "struct " . $lib_base_name . "* ");
  128.  
  129. # convert arg_name_tab and arg_type_tab into arg_tab. This is rather tricky...
  130.  
  131. foreach $func (sort keys(%arg_name_tab)) {
  132.   $_=$arg_name_tab{$func};
  133.   if ($_ eq "" || /^\s*void\s*/i)
  134.     {
  135.       # no arguments given, or just void or VOID
  136.       $arg_tab{$func} = "";
  137.       next;
  138.     }
  139.   else
  140.     {
  141.       # unpack arguments into array @names
  142.       @names = split(/,/, $arg_name_tab{$func});
  143.       # NOTE: this trick fails if someone specifies full prototypes for
  144.       #       function pointers, ie. (.., (*func)(int, int, int), ...).
  145.       #       Currently just one function in graphics.h does this, so it's
  146.       #       not worth the hassle to do it `right'.
  147.       @types = split(/,/, $arg_type_tab{$func});
  148.       # @types may still contain argument names, if they were specified
  149.       # in the proto file. This is a tricky task, separate the optional
  150.       # argument name...
  151.       foreach $i (0 .. $#types) {
  152.         @words = split(/ /,$types[$i]);
  153.         $wi=$#words;
  154.     word_loop: while ($wi > 0)
  155.       {
  156.             if ($words[$wi] =~ /[\(\)]/ && !($words[$wi - 1] =~ /[\(\)]/))
  157.               {
  158.         last word_loop;
  159.           }
  160.         elsif (!($words[$wi] =~ /[\(\)]/))
  161.           {
  162.             last word_loop;
  163.           }
  164.         $wi--;
  165.       }
  166.     # here come heuristics... (do we have a name to write over or 
  167.     # do we have to append a new element?)
  168.     if ($words[$wi] eq "int" ||
  169.         $words[$wi] eq "long" ||
  170.         $words[$wi] eq "short" ||
  171.         $words[$wi] eq "char" ||
  172.         $words[$wi] eq "*")
  173.       {
  174.         $wi++;
  175.       }
  176.     ($words[$wi] =~ s/(\W*)(\w+)(.*)/\1$names[$i]\3/) ||
  177.       ($words[$wi] = $names[$i]);
  178.     $types[$i] = "@words";
  179.       }
  180.       $arg_tab{$func} = join("|", @types);
  181.     }
  182. }
  183.  
  184. # this table maps functions that have an alternate stdarg-companion
  185. # it would probably be better (and more generic) to do this mapping with
  186. # some rather weird regular expressions. However, since almost every header
  187. # file chose a different set of naming `rules' how to deduce the stdarg-name
  188. # from the plain name, it would probably not be much better for the future,
  189. # there's no sign that this deliberate creativity in inventing new naming
  190. # conventions should stop....
  191.  
  192. %stdarg_names = (
  193.   # asl.library
  194.   'AllocAslRequest',    'AllocAslRequestTags',
  195.   'AslRequest',        'AslRequestTags',
  196.   # dos.library
  197.   'AllocDosObject',    'AllocDosObjectTags',
  198.   'CreateNewProc',    'CreateNewProcTags',
  199.   'SystemTagList',    'SystemTags',
  200.   'NewLoadSeg',        'NewLoadSegTags',
  201.   # gadtools.library
  202.   'CreateGadgetA',    'CreateGadget',
  203.   'GT_SetGadgetAttrsA',    'GT_SetGadgetAttrs',
  204.   'CreateMenusA',    'CreateMenus',
  205.   'LayoutMenuItemsA',    'LayoutMenuItems',
  206.   'LayoutMenusA',    'LayoutMenus',
  207.   'DrawBevelBoxA',    'DrawBevelBox',
  208.   'GetVisualInfoA',    'GetVisualInfo',
  209.   # graphics.library
  210.   'VideoControl',    'VideoControlTags',    # own creation ;-)
  211.   'WeighTAMatch',    'WeighTAMatchTags',    # own creation ;-)
  212.   'ExtendFont',        'ExtendFontTags',    # own creation ;-)
  213.   # intuition.library
  214.   'OpenWindowTagList',    'OpenWindowTags',
  215.   'OpenScreenTagList',    'OpenScreenTags',
  216.   'NewObjectA',        'NewObject',
  217.   'SetAttrsA',        'SetAttrs',
  218.   'SetGadgetAttrsA',    'SetGadgetAttrs',
  219.   # workbench.library
  220.   'AddAppWindowA',    'AddAppWindow',
  221.   'AddAppIconA',    'AddAppIcon',
  222.   'AddAppMenuItemA',    'AddAppMenuItem',
  223. );
  224.  
  225.  
  226. # these are aliases for some functions, that for what reason ever got two
  227. # names for the same entry point. This is a dos.library pecularity..
  228. # the list is symmetric, since it's random which of the two names actually
  229. # appears in the fd file, and is thus generated inline...
  230. %aliased_names = (
  231.   'AllocDosObjectTagList',    'AllocDosObject',
  232.   'AllocDosObject',        'AllocDosObjectTagList',
  233.   'CreateNewProcTagList',    'CreateNewProc',
  234.   'CreateNewProc',        'CreateNewProcTagList',
  235.   'SystemTagList',        'System',
  236.   'System',            'SystemTagList',
  237.   'NewLoadSegTagList',        'NewLoadSeg',
  238.   'NewLoadSeg',            'NewLoadSegTagList',
  239. );
  240.  
  241. # now output the real file
  242.  
  243. ($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($def = $2 . "_H");
  244. $def =~ s/_protos//;
  245. $def =~ tr/[a-z]/[A-Z]/;
  246.  
  247. print "#ifndef _INLINE_$def\n#define _INLINE_$def\n\n";
  248.  
  249. print "#include <sys/cdefs.h>\n";
  250. print "#include <inline/stubs.h>\n";
  251.  
  252. # this is for C++ support, it does `extern "C" {' if __cplusplus is defined
  253. print "\n__BEGIN_DECLS\n\n";
  254.  
  255. print "#ifndef BASE_EXT_DECL\n";
  256. print "#define BASE_EXT_DECL extern $lib_base_type $lib_base_name;\n";
  257. print "#endif\n";
  258.  
  259. print "#ifndef BASE_PAR_DECL\n";
  260. print "#define BASE_PAR_DECL\n";
  261. print "#define BASE_PAR_DECL0 void\n";
  262. print "#endif\n";
  263.  
  264. print "#ifndef BASE_NAME\n";
  265. print "#define BASE_NAME $lib_base_name\n";
  266. print "#endif\n\n";
  267.  
  268. foreach $func (sort keys(%result_tab)) {
  269.   # this happens if the clib/ file defines functions that only exist in amiga.lib
  270.   next if $bias_tab{$func} == 0;
  271.  
  272.   print "static __inline ",$result_tab{$func},"\n";
  273.  
  274.   if ($arg_tab{$func} eq "")
  275.     {
  276.       print $func," (BASE_PAR_DECL0)\n{\n";
  277.     }
  278.   else
  279.     {
  280.       print $func," (BASE_PAR_DECL ",join(",", split(/\|/, $arg_tab{$func})),")\n{\n";
  281.     }
  282.   print "  BASE_EXT_DECL\n";
  283.   if (!($result_tab{$func} =~ /^\s*void\s*$/i))
  284.     {
  285.       print "  register $result_tab{$func} _res $result_tab_end{$func} __asm(\"d0\");\n";
  286.     }
  287.   print "  register ${lib_base_type}a6 __asm(\"a6\") = BASE_NAME;\n";
  288.   @args = split(/\|/, $arg_tab{$func});
  289.   @names = split(/,/, $arg_name_tab{$func});
  290.   @regs = split(/[\/,]/, $reg_tab{$func});
  291.   $warn_a4a5 = 0;
  292.   $owe_nl = 0;
  293.  
  294.   if ($#args >= 0)
  295.     {
  296.       # map the fd given register list to the arguments. If there wasn't 
  297.       # DOUBLE/double, then this mapping would be 1:1, but a double variable
  298.       # is specified as taking d0/d1 in the fd file, while gcc only wants to
  299.       # see the d0.
  300.  
  301.       $i = 0;
  302.       $ri = 0;
  303.       @reg_args = ();
  304.       while ($i <= $#args)
  305.         {
  306.           $reg_args[$i] = $regs[$ri];
  307.       # double, but not double pointers, skip one register
  308.       if ($args[$i] =~ /double[^\*]*$/i)
  309.         {
  310.           $ri+=2;
  311.         }
  312.       else
  313.         {
  314.           $ri++;
  315.         }
  316.       $decl = $args[$i];
  317.       $decl =~ s/(\W)$names[$i](\W?)/\1$reg_args[$i]\2/;
  318.           print "  register $decl __asm(\"$reg_args[$i]\") = $names[$i];\n";
  319.           $i++;
  320.         }
  321.     }
  322.   printf "  __asm __volatile (\"jsr a6@(-0x%x)\"\n", $bias_tab{$func};
  323.   if ($result_tab{$func} =~ /^\s*void\s*$/i)
  324.     {
  325.       print "  : /* no output */\n";
  326.     }
  327.   else
  328.     {
  329.       print "  : \"=r\" (_res)\n";
  330.     }
  331.   if ($#args == -1)
  332.     {
  333.       print "  : \"r\" (a6)\n";
  334.     }
  335.   else
  336.     {
  337.       print "  : \"r\" (a6)";
  338.       foreach $r (@reg_args) {
  339.         print ", \"r\" ($r)";
  340.       }
  341.       print "\n";
  342.     }
  343.  
  344.   @clobb=("d0", "d1", "a0", "a1");
  345.   push (@clobb, @regs);
  346.   @clobb = sort(@clobb);
  347.   print "  : ";
  348.   # specify "memory" in each call, since each call is a subroutine call to some
  349.   # space which may do things we don't know ;-) Besides, this shouldn't hurt
  350.   # performance, and if it does, I'd need specific information HOW it hurts,
  351.   # so "memory" could be disabled in just those cases.
  352.   foreach $i (0 .. $#clobb) {
  353.     (($clobb[$i] ne $clobb[$i+1]) && ($i != $#clobb) && (print "\"$clobb[$i]\",")) ||
  354.     ($i == $#clobb && (print "\"$clobb[$i]\", \"memory\");\n"));
  355.   }
  356.  
  357. # no longer necessary, since gcc now supports `register' "memory" to denote
  358. # that memory is clobbered by indirection on registers
  359. #
  360. #  # hack.. for all arguments addressed via address registers, fake a value change
  361.   foreach $i (0 .. $#regs) {
  362. #    ($regs[$i] =~ /a[0-5]/) && 
  363. #     (print "  *(char *)$regs[$i] = *(char *)$regs[$i];") && ($owe_nl= 1);
  364.     ($regs[$i] =~ /a[45]/) && ($warn_a4a5 = 1);
  365.   }
  366.   print STDERR "Warning: $func uses a4 or a5, add code to save/restore them!\n"
  367.     if $warn_a4a5;
  368.  
  369.   print "\n" if ($owe_nl);
  370.   print "  return _res;\n" if (!($result_tab{$func} =~ /^\s*void\s*$/i));
  371.   print "}\n";
  372.   
  373.   if ($stdarg_names{$func})
  374.     {
  375.       print "#ifndef NO_INLINE_STDARG\n";
  376.       print "#define $stdarg_names{$func}(";
  377.       foreach $i (0 .. $#args-1) {
  378.     print "a$i, ";
  379.       }
  380.       print "tags...) \\\n";
  381.       print "  ({ struct TagItem _tags[] = { tags }; $func (";
  382.       foreach $i (0 .. $#args-1) {
  383.     print "(a$i), ";
  384.       }
  385.       print "_tags); })\n";
  386.       print "#endif /* not NO_INLINE_STDARG */\n";
  387.     }
  388.   
  389.   if ($aliased_names{$func})
  390.     {
  391.       # provide arguments to the macro, should reduce expansion of the macro
  392.       # at the wrong place..
  393.       print "#define $aliased_names{$func}(";
  394.       foreach $i (0 .. $#args-1) {
  395.     print "a$i, ";
  396.       }
  397.       print "a$#args) $func (";
  398.       foreach $i (0 .. $#args-1) {
  399.     print "(a$i), ";
  400.       }
  401.       print "(a$#args))\n";
  402.     }
  403. }
  404.  
  405. print "#undef BASE_EXT_DECL\n";
  406. print "#undef BASE_PAR_DECL\n";
  407. print "#undef BASE_PAR_DECL0\n";
  408. print "#undef BASE_NAME\n";
  409.  
  410. print "\n__END_DECLS\n\n";
  411.  
  412. print "#endif /* _INLINE_$def */\n";
  413.